Your Choice 1/your choice.zip/your choice/PRGMMING/MOUDESIG/MDEMO1.BAS

BASIC Source File | 1993-04-20 | 13KB | 403 lines

'≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
'
'                             Mouse Design 1.0
'                                MouseDEMO 1
'
'               How to use mouse control in QuickBASIC 4.50
'
'                   Written in 1993 by Rudi Breedenraedt
'                               PUBLIC DOMAIN
'
' This program is a part of the Mouse Design package and is a simple demon-
' stration of how to use mouse control in your software. This program (not
' the other programs of the Mouse Design package) is public domain, so you
' may use the routines of this program into your own software.
'
'≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

DECLARE FUNCTION mouse.present% ()
DECLARE FUNCTION mouse.buttons% ()
DECLARE SUB mouse.hide ()
DECLARE SUB mouse.show ()
DECLARE SUB mouse.where (x%, y%, b%)
DECLARE SUB mouse.lastpressed (b%, x%, y%, times%)
DECLARE SUB mouse.lastreleased (b%, x%, y%, times%)
DECLARE SUB mouse.window (x1%, y1%, x2%, y2%)
DECLARE FUNCTION using$ (format$, number%)
DECLARE SUB box (y%, x%, l%, h%, t%)
DECLARE SUB mainscreen ()
DECLARE SUB update.lastpressed ()
DECLARE SUB update.area ()
DECLARE SUB update.visibility ()

'============================================================================
' Necessary to call interrupts :
'============================================================================

'$INCLUDE: 'qb.bi'
DIM SHARED Reg AS RegType

'============================================================================
' Is there a mouse ? If no, quit with errormessage :
'============================================================================

IF NOT mouse.present% THEN
   PRINT "Microsoft mouse not found."
   END
   END IF

'============================================================================
' Initialising :
'============================================================================

DIM F1 AS STRING * 2
DIM F2 AS STRING * 2
DIM F3 AS STRING * 2
  F1 = CHR$(0) + ";"
  F2 = CHR$(0) + "<"
  F3 = CHR$(0) + "="
CALL mainscreen
'Initialising vars:
buttons% = mouse.buttons%
hidden% = 0
lplx% = 0
lply% = 0
lprx% = 0
lpry% = 0
times% = 0
area$ = "Unlock"
visi$ = "ON"
buttons% = mouse.buttons%
mouse.window 32, 2, 79, 24
mouse.show

'============================================================================
' Main loop of the program: update the data on the screen and look if
' functionkeys are pressed :
'============================================================================
LOCATE 3, 19: PRINT using$("0", buttons%)
LOCATE 10, 24: PRINT using$("00", 1)
LOCATE 11, 24: PRINT using$("00", 1)
LOCATE 12, 24: PRINT using$("00", 1)
LOCATE 13, 24: PRINT using$("00", 1)
LOCATE 18, 16: PRINT "Unlocked"
LOCATE 23, 22: PRINT "Visible"

DO
  k$ = INKEY$
  mouse.where x%, y%, b%
  LOCATE 4, 11: PRINT using$("00", x%)
  LOCATE 5, 11: PRINT using$("00", y%)
  LOCATE 6, 20
  SELECT CASE b%
    CASE 0
      PRINT "None      "
    CASE 1
      PRINT "Left      "
    CASE 2
      PRINT "Right     "
    CASE 3
      PRINT "Left+Right"
    CASE 4
      PRINT "Middle    "
    CASE 5
      PRINT "Left+Midd."
    CASE 6
      PRINT "Right+Mid."
    CASE 7
      PRINT "All       "
  END SELECT
  IF k$ = F1 THEN CALL update.lastpressed
  IF k$ = F2 THEN : CALL update.area
  IF k$ = F3 THEN : CALL update.visibility
LOOP UNTIL k$ = CHR$(27)

'============================================================================
' End of the demo :
'============================================================================

Reg.ax = 0                 'This interruptcall resets the
INTERRUPT &H33, Reg, Reg   'mouse driver.
COLOR 7, 0
CLS
END

SUB box (y%, x%, l%, h%, t%)
' Draws a box with lines where x and y gives the left top corner,
' l the length, h the hight and t the form as :
'  t = 0 : draw box with spaces
'  t = 1 : draw box with ┌,─,┘,│,┐ and └
'  t = 2 : draw box with ╔,═,╝,║,╗ and ╚
'  t = 3 : draw box with ▀,▄ and █.
' l and h may not be less than two and the box must match
' with the screen coordinates, else no box will be drawn.
' Note : the box will be drawn in the actual color attributes.

DIM lines(1 TO 7) AS STRING * 1
DIM curx, cury AS INTEGER
IF l% < 2 OR h% < 2 THEN EXIT SUB
IF (x% = l%) > 81 OR (y% + h%) > 26 THEN EXIT SUB
curx = POS(0): cury = CSRLIN
IF t% = 0 THEN
   lines(1) = " "
   lines(2) = " "
   lines(3) = " "
   lines(4) = " "
   lines(5) = " "
   lines(6) = " "
   lines(7) = " "
   END IF
IF t% = 1 THEN
   lines(1) = "┌"
   lines(2) = "┘"
   lines(3) = "┐"
   lines(4) = "└"
   lines(5) = "│"
   lines(6) = "─"
   lines(7) = "─"
   END IF
IF t% = 2 THEN
   lines(1) = "╔"
   lines(2) = "╝"
   lines(3) = "╗"
   lines(4) = "╚"
   lines(5) = "║"
   lines(6) = "═"
   lines(7) = "═"
   END IF
IF t% = 3 THEN
   lines(1) = "█"
   lines(2) = "█"
   lines(3) = "█"
   lines(4) = "█"
   lines(5) = "█"
   lines(6) = "▀"
   lines(7) = "▄"
   END IF
LOCATE y%, x%: PRINT lines(1); STRING$(l% - 2, lines(6)); lines(3);
FOR n% = y% + 1 TO y% + h% - 2
    LOCATE n%, x%: PRINT lines(5); STRING$(l% - 2, 32); lines(5);
NEXT n%
LOCATE y% + h% - 1, x%: PRINT lines(4); STRING$(l% - 2, lines(7)); lines(2);
LOCATE cury, curx
END SUB

SUB mainscreen
COLOR 7, 0
CLS
COLOR 15, 1
box 1, 1, 30, 7, 2
box 8, 1, 30, 8, 1
box 16, 1, 30, 5, 1
box 21, 1, 30, 5, 1
COLOR 4, 0
box 1, 31, 50, 25, 3
COLOR 8
FOR n = 1 TO 6
  LOCATE 16 + n, 60: PRINT STRING$(15, 219);
NEXT n
COLOR 14, 0
LOCATE 3, 45: PRINT "Mouse Design : MDEMO1"
LOCATE 4, 42: PRINT "Mouse control in QuickBASIC"
COLOR 15, 1
LOCATE 1, 3: PRINT "▌PRESENT MOUSE STATUS▐"
LOCATE 8, 3: PRINT "▌LAST PRESSED WHERE▐"
LOCATE 16, 3: PRINT "▌AREA▐"
LOCATE 21, 3: PRINT "▌VISIBILITY▐"

LOCATE 3, 3: PRINT "Nbr of buttons:"
LOCATE 4, 3: PRINT "X-axis:"
LOCATE 5, 3: PRINT "Y-axis:"
LOCATE 6, 3: PRINT "Pressed buttons:"
LOCATE 10, 3: PRINT "Lastpressed left: X:"
LOCATE 11, 3: PRINT "                  Y:"
LOCATE 12, 3: PRINT "           right: X:"
LOCATE 13, 3: PRINT "                  Y:"
LOCATE 18, 3: PRINT "Area status:"
LOCATE 23, 3: PRINT "Visibility status:"

COLOR 9, 1
LOCATE 14, 3: PRINT "F1 TO UPDATE"
LOCATE 19, 3: PRINT "F2 TO TOGLE LOCK/UNLOCK"
LOCATE 24, 3: PRINT "F3 TO TOGLE ON/OFF";
COLOR 7, 1
END SUB

'----------------------------------------------------------------------------
' This function returns the number of buttons on the mouse (2 or 3).
' IMPORTANT NOTE: this function also resets the mouse driver, so after
'   executing this function, the mouse will be hidden and the mouse
'   window will be reset to the whole screen !
'----------------------------------------------------------------------------
FUNCTION mouse.buttons%
Reg.ax = 0
INTERRUPT &H33, Reg, Reg
IF Reg.bx = -1 THEN Reg.bx = 2
mouse.buttons% = Reg.bx
END FUNCTION

'----------------------------------------------------------------------------
' This routine makes the mouse cursor invisible. The mouse cursor can
' be made visible again with the subroutine mouse.show.
' IMPORTANT NOTE: multiple calls of this subroutine will require multiple
'   calls of the subroutine mouse.show to unhide the mouse cursor !
'----------------------------------------------------------------------------
SUB mouse.hide
Reg.ax = 2
INTERRUPT &H33, Reg, Reg
END SUB

'----------------------------------------------------------------------------
' Specify with b% which button to check (1=left, 2=right, 3=middle), this
' routine will then return the x and y coordinates where this mouse button
' was last pressed. The variable times% will tell you how many times the
' specified button was pressed since you called this routine last.
' IMPORTANT NOTE: This subroutine should be modified for use in a graphical
'   environment because of the difference in screen resolution !
'----------------------------------------------------------------------------
SUB mouse.lastpressed (b%, x%, y%, times%)
Reg.ax = 5
Reg.bx = b% - 1
INTERRUPT &H33, Reg, Reg
times% = Reg.bx
x% = Reg.cx \ 8 + 1
y% = Reg.dx \ 8 + 1
END SUB

'----------------------------------------------------------------------------
' Specify with b% which button to check (1=left, 2=right, 3=middle), this
' routine will then return the x and y coordinates where this mouse button
' was last released. The variable times% will tell you how many times the
' specified button was released since you called this routine last.
' IMPORTANT NOTE: This subroutine should be modified for use in a graphical
'   environment because of the difference in screen resolution !
'----------------------------------------------------------------------------
SUB mouse.lastreleased (b%, x%, y%, times%)
Reg.ax = 6
Reg.bx = b% - 1
INTERRUPT &H33, Reg, Reg
times% = Reg.bx
x% = Reg.cx \ 8 + 1
y% = Reg.dx \ 8 + 1
END SUB

'----------------------------------------------------------------------------
' This routine makes it possible to locate the mouse cursor on a specified
' location on the screen.
' IMPORTANT NOTE: This subroutine should be modified for use in a graphical
'   environment because of the difference in screen resolution !
'----------------------------------------------------------------------------
SUB mouse.locate (x%, y%)
Reg.ax = 4
Reg.cx = (x% - 1) * 8
Reg.dx = (y% - 1) * 8
INTERRUPT &H33, Reg, Reg
END SUB

'----------------------------------------------------------------------------
' This function returns 0 if there is no mouse connected, or if the
' mouse driver MOUSE.COM is not loaded. Else the function returns -1.
' When you begin a mouse controlled program you should use this function
' to check if the mouse is present.
' IMPORTANT NOTE: this function also resets the mouse driver, so after
'   executing this function, the mouse will be hidden and the mouse
'   window will be reset to the whole screen !
'----------------------------------------------------------------------------
FUNCTION mouse.present%
Reg.ax = 0
INTERRUPT &H33, Reg, Reg
mouse.present% = Reg.ax
END FUNCTION

'----------------------------------------------------------------------------
' This routine makes the mouse cursor visible. The mouse cursor can
' be made invisible with the subroutine mouse.hide.
' When you begin a mouse controlled program you should use this routine
' to make the mouse cursor visible.
'----------------------------------------------------------------------------
SUB mouse.show
Reg.ax = 1
INTERRUPT &H33, Reg, Reg
END SUB

'----------------------------------------------------------------------------
' This routine looks where the mouse cursor actually is located, and if
' there are buttons pressed. The variable b% returns 0 of no button is
' pressed, 1 if the left one is pressed, 2 if the right, 3 if both left
' and right are pressed. It adds 4 to this value if the middle button is
' pressed.
' IMPORTANT NOTE: This subroutine should be modified for use in a graphical
'   environment because of the difference in screen resolution !
'----------------------------------------------------------------------------
SUB mouse.where (x%, y%, b%)
Reg.ax = 3
INTERRUPT &H33, Reg, Reg
b% = Reg.bx
x% = Reg.cx \ 8 + 1
y% = Reg.dx \ 8 + 1
END SUB

'----------------------------------------------------------------------------
' This routine makes it possible to lock the mouse cursor in a specified
' rectangular block with x1%,y1% as coordinates of the upper left corner,
' and x2%,y2% as coordinates of the lower right corner.
' To unlock the mouse, call this routine back again with the coordinates
' of the whole screen.
' IMPORTANT NOTE: This subroutine should be modified for use in a graphical
'   environment because of the difference in screen resolution !
'----------------------------------------------------------------------------
SUB mouse.window (x1%, y1%, x2%, y2%)
Reg.ax = 7
Reg.cx = (x1% - 1) * 8
Reg.dx = (x2% - 1) * 8
INTERRUPT &H33, Reg, Reg
Reg.ax = 8
Reg.cx = (y1% - 1) * 8
Reg.dx = (y2% - 1) * 8
INTERRUPT &H33, Reg, Reg
END SUB

SUB update.area
STATIC status$
IF status$ = "" THEN status$ = "Unlocked"
IF status$ = "Unlocked" THEN
   status$ = "Locked  "
   mouse.window 60, 17, 74, 22
ELSE
   status$ = "Unlocked"
   mouse.window 32, 2, 79, 24
END IF
LOCATE 18, 16: PRINT status$
END SUB

SUB update.lastpressed
mouse.lastpressed 1, x%, y%, t%
LOCATE 10, 24: PRINT using$("00", x%)
LOCATE 11, 24: PRINT using$("00", y%)
mouse.lastpressed 2, x%, y%, t%
LOCATE 12, 24: PRINT using$("00", x%)
LOCATE 13, 24: PRINT using$("00", y%)
END SUB

SUB update.visibility
STATIC status$
IF status$ = "" THEN status$ = "Visible"
IF status$ = "Visible" THEN
   status$ = "Hidden "
   mouse.hide
ELSE
   status$ = "Visible"
   mouse.show
END IF
LOCATE 23, 22: PRINT status$
END SUB

FUNCTION using$ (format$, number%)
s$ = RTRIM$(LTRIM$(STR$(number%)))
DO WHILE LEN(s$) < LEN(format$)
  s$ = "0" + s$
LOOP
using$ = s$
END FUNCTION